home *** CD-ROM | disk | FTP | other *** search
/ SuperHack / SuperHack CD.bin / CODING / DELPHI / HTMLVIEW.ZIP / DEMOSRC.ZIP / DEMOUNIT.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-01-21  |  9.5 KB  |  365 lines
  1. unit Demounit;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, ExtCtrls, Menus, Htmlview, StdCtrls, HtmlSubs, FontDlg,
  8.   htmlabt, Submit;
  9.  
  10. const
  11.   MaxHistories = 6;  {size of History list}
  12. type
  13.   TForm1 = class(TForm)
  14.     OpenDialog: TOpenDialog;
  15.     MainMenu: TMainMenu;
  16.     Panel1: TPanel;
  17.     Panel2: TPanel;
  18.     Panel3: TPanel;
  19.     Viewer: THTMLViewer;
  20.     File1: TMenuItem;
  21.     Open: TMenuItem;
  22.     options1: TMenuItem;
  23.     ShowImages: TMenuItem;
  24.     Fonts: TMenuItem;
  25.     Edit1: TEdit;
  26.     Reload: TButton;
  27.     BackButton: TButton;
  28.     FwdButton: TButton;
  29.     HistoryMenuItem: TMenuItem;
  30.     Exit: TMenuItem;
  31.     N1: TMenuItem;
  32.     Print1: TMenuItem;
  33.     PrintDialog: TPrintDialog;
  34.     About1: TMenuItem;
  35.     Edit2: TMenuItem;
  36.     Find1: TMenuItem;
  37.     FindDialog: TFindDialog;
  38.     procedure OpenFileClick(Sender: TObject);
  39.     procedure HotSpotChange(Sender: TObject; const URL: string);
  40.     procedure HotSpotClick(Sender: TObject; const URL: string;
  41.               var Handled: boolean);
  42.     procedure ShowImagesClick(Sender: TObject);
  43.     procedure ReloadClick(Sender: TObject);
  44.     procedure FormCreate(Sender: TObject);
  45.     procedure FormDestroy(Sender: TObject);
  46.     procedure FwdBackClick(Sender: TObject);
  47.     procedure HistoryClick(Sender: TObject);
  48.     procedure HistoryChange(Sender: TObject);
  49.     procedure ExitClick(Sender: TObject);
  50.     procedure FontColorsClick(Sender: TObject);
  51.     procedure Print1Click(Sender: TObject);
  52.     procedure About1Click(Sender: TObject);
  53.     procedure FormShow(Sender: TObject);
  54.     procedure SubmitEvent(Sender: TObject; Action, Method: String;
  55.       Results: TStringList);
  56.     procedure Find1Click(Sender: TObject);
  57.     procedure FindDialogFind(Sender: TObject);
  58.     procedure ProcessingHandler(Sender: TObject; ProcessingOn: Boolean);
  59.   private
  60.     { Private declarations }
  61.     SndHandle : THandle;
  62.     PlaySound : function (lpszSoundName: PChar; uFlags: Word): Bool;
  63.     Histories: array[0..MaxHistories-1] of TMenuItem;
  64.     procedure FontChange(Sender: TObject);
  65.   public
  66.     { Public declarations }
  67.   end;
  68.  
  69. var
  70.   Form1: TForm1;
  71.  
  72. implementation
  73.  
  74. {$R *.DFM}
  75.  
  76. procedure TForm1.FormCreate(Sender: TObject);
  77. var
  78.   I: integer;
  79. begin
  80. OpenDialog.InitialDir := ExtractFilePath(ParamStr(0));
  81.  
  82. {make sure mmsystem.dll exists before calling sndPlaySound}
  83. SndHandle := LoadLibrary('mmsystem.dll');
  84. if SndHandle >= 32 then
  85.   @PlaySound := GetProcAddress(SndHandle, 'sndPlaySound');
  86.  
  87. Viewer.HistoryMaxCount := MaxHistories;  {defines size of history list}
  88.  
  89. for I := 0 to MaxHistories-1 do
  90.   begin      {create the MenuItems for the history list}
  91.   Histories[I] := TMenuItem.Create(HistoryMenuItem);
  92.   HistoryMenuItem.Insert(I, Histories[I]);
  93.   with Histories[I] do
  94.     begin
  95.     Visible := False;
  96.     OnClick := HistoryClick;
  97.     Tag := I;
  98.     end;
  99.   end;
  100. end;
  101.  
  102. procedure TForm1.FormShow(Sender: TObject);
  103. begin
  104. if (ParamCount >= 1) then
  105.   Viewer.LoadFromFile(ParamStr(1));  {Parameter is file to load}
  106. end;
  107.  
  108. procedure TForm1.FormDestroy(Sender: TObject);
  109. begin
  110. if SndHandle >= 32 then FreeLibrary(SndHandle);
  111. end;
  112.  
  113. procedure TForm1.OpenFileClick(Sender: TObject);
  114. begin
  115. if Viewer.CurrentFile <> '' then
  116.   OpenDialog.InitialDir := ExtractFilePath(Viewer.CurrentFile);
  117. if OpenDialog.Execute then
  118.   begin
  119.   Viewer.LoadFromFile(OpenDialog.Filename);
  120.   Caption := Viewer.DocumentTitle;
  121.   end;
  122. end;
  123.  
  124. procedure TForm1.HotSpotChange(Sender: TObject; const URL: string);
  125. {mouse moved over or away from a hot spot.  Change the status line}
  126. begin
  127. Panel1.Caption := URL;
  128. end;
  129.  
  130. procedure TForm1.HotSpotClick(Sender: TObject; const URL: string;
  131.           var Handled: boolean);
  132. {This routine handles what happens when a hot spot is clicked.  The assumption
  133.  is made that DOS filenames are being used. .EXE and .WAV files are handled
  134.  here, but other file types could be easily added.
  135.  
  136.  If the URL is handled here, set Handled to True.  If not handled here, set it
  137.  to False and ThtmlViewer will handle it.}
  138. const
  139.   snd_Async = $0001;  { play asynchronously }
  140. var
  141.   PC: array[0..255] of char;
  142.   S, Params: string[80];
  143.   Ext: string[5];
  144.   I, J, K: integer;
  145.  
  146. begin
  147. Handled := False;
  148. I := Pos(':', URL);
  149. J := Pos('FILE:', UpperCase(URL));
  150. if (I <= 2) or (J > 0) then
  151.   begin                      {apparently the URL is a filename}
  152.   S := URL;
  153.   K := Pos(' ', S);
  154.   if K > 0 then
  155.     begin
  156.     Params := Copy(S, K, 255);   {save any parameters}
  157.     S[0] := chr(K-1);            {truncate S}
  158.     end
  159.   else Params := '';
  160.   S := Viewer.HTMLExpandFileName(S);
  161.   Ext := Uppercase(ExtractFileExt(S));
  162.   if Ext = '.WAV' then
  163.     begin
  164.     Handled := True;
  165.     if Assigned(PlaySound) then
  166.       PlaySound(StrPCopy(PC, S), snd_ASync);
  167.     end
  168.   else if Ext = '.EXE' then
  169.     begin
  170.     Handled := True;
  171.     WinExec(StrPCopy(PC, S+Params), sw_Show);
  172.     end;
  173.   {else ignore other extensions}
  174.   Edit1.Text := URL;
  175.   end
  176. else Edit1.Text := URL;   {other protocall, mailto:, ftp:, etc.}
  177. end;
  178.  
  179. procedure TForm1.ShowImagesClick(Sender: TObject);
  180. {The Show Images menu item was clicked}
  181. begin
  182. With Viewer do
  183.   begin
  184.   ViewImages := not ViewImages;
  185.   (Sender as TMenuItem).Checked := ViewImages;
  186.   end;
  187. end;
  188.  
  189. procedure TForm1.ReloadClick(Sender: TObject);
  190. {the Reload button was clicked}
  191. var
  192.   Pos: LongInt;
  193. begin
  194. with Viewer do
  195.   begin
  196.   ReLoad.Enabled := False;
  197.   Pos := Position;     {save the postion}
  198.   LoadFromFile(CurrentFile);   {load again}
  199.   Position := Pos;     {restore position}
  200.   Reload.Enabled := CurrentFile <> '';
  201.   end;
  202. end;
  203.  
  204. procedure TForm1.FwdBackClick(Sender: TObject);
  205. {Either the Forward or Back button was clicked}
  206. begin
  207. with Viewer do
  208.   begin
  209.   if Sender = BackButton then
  210.     HistoryIndex := HistoryIndex +1
  211.   else
  212.     HistoryIndex := HistoryIndex -1;
  213.   end;
  214. end;
  215.  
  216. procedure TForm1.HistoryChange(Sender: TObject);
  217. {This event occurs when something changes history list}
  218. var
  219.   I: integer;
  220. begin
  221. with Sender as ThtmlViewer do
  222.   begin
  223.   {check to see which buttons are to be enabled}
  224.   FwdButton.Enabled := HistoryIndex > 0;
  225.   BackButton.Enabled := HistoryIndex < History.Count-1;
  226.  
  227.   {Enable and caption the appropriate history menuitems}
  228.   HistoryMenuItem.Visible := History.Count > 0;
  229.   for I := 0 to MaxHistories-1 do
  230.     with Histories[I] do
  231.       if I < History.Count then
  232.         Begin
  233.         Caption := History.Strings[I];
  234.         Visible := True;
  235.         Checked := I = HistoryIndex;
  236.         end
  237.       else Histories[I].Visible := False; 
  238.   Caption := DocumentTitle;    {keep the caption updated}
  239.   end;
  240. end;
  241.  
  242. procedure TForm1.HistoryClick(Sender: TObject);
  243. {A history list menuitem got clicked on}
  244. begin
  245.   {Changing the HistoryIndex loads and positions the appropriate document}
  246.   Viewer.HistoryIndex := (Sender as TMenuItem).Tag;
  247. end;
  248.  
  249. procedure TForm1.ExitClick(Sender: TObject);
  250. begin
  251. Close;
  252. end;
  253.  
  254. procedure TForm1.FontChange(Sender: TObject);
  255. begin
  256. with FontForm do
  257.   begin
  258.   Viewer.DefFontName := FontName;
  259.   Viewer.DefFontColor := FontColor;
  260.   Viewer.DefHotSpotColor := HotSpotColor;
  261.   Viewer.DefBackground := Background;
  262.   end;
  263. end;
  264.  
  265. procedure TForm1.FontColorsClick(Sender: TObject);
  266. var
  267.   I: Integer;
  268.   FontForm: TFontForm;
  269. begin
  270. try
  271.   FontForm := TFontForm.Create(Self);
  272.   with FontForm do
  273.     begin
  274.     FontName := Viewer.DefFontName;
  275.     FontColor := Viewer.DefFontColor;
  276.     FontSize := Viewer.DefFontSize;
  277.     HotSpotColor := Viewer.DefHotSpotColor;
  278.     Background := Viewer.DefBackground;
  279.     if ShowModal = mrOK then
  280.       begin
  281.       Viewer.DefFontName := FontName;
  282.       Viewer.DefFontColor := FontColor;
  283.       Viewer.DefFontSize := FontSize;
  284.       Viewer.DefHotSpotColor := HotSpotColor;
  285.       Viewer.DefBackground := Background;
  286.       ReloadClick(Self);    {reload to see how it looks}
  287.       end;
  288.     end;
  289. finally
  290.   FontForm.Free;
  291.  end;
  292. end;
  293.  
  294. procedure TForm1.Print1Click(Sender: TObject);
  295. begin
  296. with PrintDialog do
  297.   if Execute then
  298.     if PrintRange = prAllPages then
  299.       viewer.Print(1, 9999)
  300.     else
  301.       Viewer.Print(FromPage, ToPage);
  302. end;
  303.  
  304. procedure TForm1.About1Click(Sender: TObject);
  305. begin
  306. try
  307.   AboutBox := TAboutBox.Create(Self);
  308.   AboutBox.ShowModal;
  309. finally
  310.   AboutBox.Free;
  311.   end;
  312. end;
  313.  
  314.  
  315. procedure TForm1.SubmitEvent(Sender: TObject; Action, Method: String;
  316.   Results: TStringList);
  317. begin
  318. with SubmitForm do
  319.   begin
  320.   ActionText.Text := Action;
  321.   MethodText.Text := Method;
  322.   ResultBox.Items := Results;
  323.   Results.Free;
  324.   Show;
  325.   end;
  326. end;
  327.  
  328. procedure TForm1.Find1Click(Sender: TObject);
  329. begin
  330. FindDialog.Execute;
  331. end;
  332.  
  333. procedure TForm1.FindDialogFind(Sender: TObject);
  334. begin
  335. with FindDialog do
  336.   begin
  337.   if not Viewer.Find(FindText, frMatchCase in Options) then
  338.     MessageDlg('No further occurances of "'+FindText+'"', mtInformation, [mbOK], 0);
  339.   end;
  340. end;
  341.  
  342. procedure TForm1.ProcessingHandler(Sender: TObject; ProcessingOn: Boolean);
  343. begin
  344. if ProcessingOn then
  345.   begin    {disable various buttons and menuitems during processing}
  346.   FwdButton.Enabled := False;
  347.   BackButton.Enabled := False;
  348.   Reload.Enabled := False;
  349.   Print1.Enabled := False;
  350.   Find1.Enabled := False;
  351.   Open.Enabled := False;
  352.   end
  353. else
  354.   begin
  355.   FwdButton.Enabled := Viewer.HistoryIndex > 0;
  356.   BackButton.Enabled := Viewer.HistoryIndex < Viewer.History.Count-1;
  357.   ReLoad.Enabled := Viewer.CurrentFile <> '';
  358.   Print1.Enabled := Viewer.CurrentFile <> '';
  359.   Find1.Enabled := Viewer.CurrentFile <> '';
  360.   Open.Enabled := True;
  361.   end;
  362. end;
  363.  
  364. end.
  365.